home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
print
/
isigns50.zip
/
SIGNS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-10-02
|
30KB
|
623 lines
{$N-} {80287 not present}
{$R+} {Range checking on}
{$S+} {Stack checking on}
{$I+} {I/O checking on}
PROGRAM Signs;
{******************************************************************************
**
** Robert W. Bloom
**
** Function: This program reads input from the terminal and creates signs
** (horizontal) or banners (vertical) in a number of formats. Output
** character fonts are read from a HP LaserJet-compatible 'soft' font file.
**
** Notes: Font files must be indexed with FontIndx.Pas before use.
** See Signs.DOC for more information
**
******************************************************************************}
Uses
Crt, {Unit found in TURBO.TPL}
Printer2; {special unit}
{$i const}
VAR
font_file : FILE OF CHAR; {the soft font file}
font_ndx_file : FILE OF CHAR_INDEX_RECORD; {index to above}
ndx_array : ARRAY [0..255] OF CHAR_INDEX_RECORD;
in_file,out_file : TEXT; {files for input and output}
avail_width : INTEGER; {width of output device}
out_line : OUT_LINE_REC; {to build output lines}
gout_1,gout_2 : OUT_GRAPHIC_REC; {output graphics lines}
gout_len : INTEGER; {to build output graphic lines}
ptr_maps : POINTER; {pointer to character maps}
map_size : INTEGER; {size of the maps}
space_needed : INTEGER; {approx width of output?}
page_offset : INTEGER; {actual indent}
bit_cnt : INTEGER; {counter for graphics output}
{************************* Procedures called *********************************}
PROCEDURE main; FORWARD;
PROCEDURE out_sign (VAR inp_line : S255); FORWARD;
PROCEDURE out_banner (VAR inp_line : S255); FORWARD;
PROCEDURE parm_menu; FORWARD;
{PROCEDURE disp_?}
PROCEDURE ask_parm; FORWARD;
{PROCEDURE ask_?}
PROCEDURE input_menu; FORWARD;
{utilities:}
PROCEDURE gotorc(R,C : INTEGER); FORWARD;
PROCEDURE sak; FORWARD;
PROCEDURE alt_inp(VAR alt_str : S14); FORWARD;
PROCEDURE putchr (chrs : S14); FORWARD;
PROCEDURE disp_fs; FORWARD;
PROCEDURE init_ff (VAR ff,ffi : S14;VAR ok : BOOLEAN); FORWARD;
PROCEDURE set_up_maps (VAR inp_line : S255); FORWARD;
PROCEDURE reset_maps (VAR ptr : POINTER); FORWARD;
{printer stuff:}
PROCEDURE avail_space; FORWARD;
PROCEDURE set_up_prt (reset_prt : BOOLEAN); FORWARD;
PROCEDURE out_char (ochar,ichar,action : CHAR); FORWARD;
PROCEDURE out_nline; FORWARD;
PROCEDURE add_gline; FORWARD;
PROCEDURE out_gl_ids; FORWARD;
PROCEDURE out_gl_hp; FORWARD;
PROCEDURE out_gl_ep; FORWARD;
{**************************** Program Start **********************************}
PROCEDURE main;
LABEL finis,restrt;
VAR ans2,ans : CHAR; {entered char}
text_input : S255; {to build line into}
alt_inp_strng : S14; {return from alt-char builder}
done : BOOLEAN; {flag}
i : INTEGER; {loop control}
output_err : BOOLEAN; {if can't output correctly}
BEGIN
done := FALSE;
text_input := '';
space_needed := 0;
parm_menu;
ask_parm;
input_menu;
WHILE NOT done DO BEGIN
restrt:
ans := READKEY;
CLREOL;
CASE ans OF
^P : BEGIN {change parameters}
ask_parm;
GOTORC(17,41); CLREOL;
input_menu;
IF sign_type = sign THEN BEGIN {recalc cause font may}
space_needed := given_offset; {have been changed}
FOR i := 1 TO LENGTH(text_input) DO
space_needed := space_needed +
(ndx_array[ORD(text_input[i])].delta_x * mult_w)
END ELSE
space_needed := (font_height * mult_h) + given_offset;
{end}
GOTORC(17,25); CLREOL; highvideo; WRITE(space_needed);
GOTORC(19,25); CLREOL; highvideo; WRITE(text_input)
END;
^D,^C : done := TRUE; {done program}
^A : BEGIN
alt_inp(alt_inp_strng);
text_input := text_input + alt_inp_strng;
GOTORC(19,25); CLREOL; highvideo; WRITE(text_input)
END;
^L,^F : BEGIN {formfeed to printer}
GOTORC(24,1);
IF output_device = printr THEN BEGIN
WRITE(lst,^L);
WRITE('Formfeed sent to printer.')
END ELSE
WRITE('Output is not directed to printer!'^G);
{end}
sak;
GOTORC(24,1); CLREOL;
GOTORC(19,25); CLREOL; highvideo; WRITE(text_input)
END;
^R,^T : BEGIN {move back to TOF (reverse formfeed)}
GOTORC(24,1);
IF output_device = printr THEN BEGIN
WRITE('Moving print-head back to TOF.');
CASE prt_type OF
ids : WRITE(lst,CHR(27),'G0$',CHR(27),'H0$');
epson : {not available?} ;
hp : WRITE(lst,CHR(27),'&a0c0R')
END {case}
END ELSE
WRITE('Output is not directed to printer!'^G);
{end}
sak;
GOTORC(24,1); CLREOL;
GOTORC(19,25); CLREOL; highvideo; WRITE(text_input)
END;
^H,#127 : BEGIN {backspace once}
IF LENGTH(text_input) > 0 THEN BEGIN
ans2 := text_input[LENGTH(text_input)];
DELETE(text_input,LENGTH(text_input),1);
IF sign_type = sign THEN space_needed :=
space_needed - (ndx_array[ORD(ans2)].delta_x * mult_w);
GOTORC(17,25); CLREOL; highvideo; WRITE(space_needed);
GOTORC(19,25); CLREOL; highvideo; WRITE(text_input)
END
END;
^X : BEGIN {cancel line, start over}
text_input := '';
IF sign_type = sign THEN
space_needed := given_offset
ELSE
space_needed := (font_height * mult_h) + given_offset;
{end}
GOTORC(17,25); CLREOL; highvideo; WRITE(space_needed);
GOTORC(19,25); CLREOL; highvideo
END;
^M : BEGIN {go ahead, process input line}
output_err := FALSE;
IF (LENGTH(text_input) = 0) AND
(input_device <> text_file) THEN BEGIN
GOTORC(24,1); CLREOL;
WRITE('Do you want to quit? (Y/N) -> '^G);
ans2 := READKEY;
GOTORC(24,1); CLREOL;
IF ans2 IN ['y','Y'] THEN